home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 December / PSL Monthly Shareware CD-ROM (Public Software Library)(December 1994).bin / prgmming / dos / pascal1 / real_r.pas < prev    next >
Pascal/Delphi Source File  |  1993-04-20  |  5KB  |  155 lines
  1. UNIT Real_RV;
  2.  
  3. (****************************************************************************
  4.  
  5. RealRangeValidator for TP 7.0
  6.  
  7.   concept by:  Steve Schafer (TeamB), see below
  8.  modified by:  Ludger Weigel, 10041,1764
  9.  
  10.  example: for a RRV, which accepts real-input like this:  0 < x <= 10.5
  11.  call:  RRV:=New(PRealRangeValidator, Init(RRV_higher, 0, RRV_equal, 10.5));
  12.  
  13. *****************************************************************************)
  14.  
  15. INTERFACE
  16.  
  17. uses Objects, Validate;
  18.  
  19. const RRV_equal  = 0;
  20.       RRV_higher = 1;
  21.       RRV_lower  = 2;
  22.  
  23. type
  24.    PRealRangeValidator = ^TRealRangeValidator;
  25.    TRealRangeValidator = object (TRangeValidator)
  26.      MaxReal, MinReal : Real;
  27.      MaxType, MinType : Byte;
  28.      constructor Init (AMinType:byte; AMin:Real; AMaxType:byte; AMax:Real);
  29.      constructor Load (var S: TStream);
  30.      procedure Error; virtual;
  31.      function IsValid (const S: String): Boolean; virtual;
  32.      procedure Store (var S: TStream);
  33.      function Transfer (var S: String; Buffer: Pointer; Flag: TVTransfer): Word; virtual;
  34.    end;
  35.  
  36.  
  37. IMPLEMENTATION
  38.  
  39. uses MsgBox;
  40.  
  41. constructor TRealRangeValidator.Init (AMinType:byte; AMin:Real; AMaxType:byte; AMax:Real);
  42. begin
  43. inherited Init (0,1);
  44. ValidChars := ValidChars + ['-','.']; { "." -> "," for german notation ! }
  45. MinReal := AMin;
  46. MaxReal := AMax;
  47. MinType := AMinType;
  48. MaxType := AMaxType;
  49. end;
  50.  
  51. constructor TRealRangeValidator.Load (var S: TStream);
  52. begin
  53. inherited Load (S);
  54. S.Read (MinReal,SizeOf (MinReal));
  55. S.Read (MaxReal,SizeOf (MaxReal));
  56. S.Read (MinType,SizeOf (MinType));
  57. S.Read (MaxType,SizeOf (MaxType));
  58. end;
  59.  
  60.  
  61. procedure TRealRangeValidator.Error;
  62. const RRV_MinType : array[0..2] of string=('higher or equal ',
  63.                                            'higher          ','?-ERROR!        ');
  64. const RRV_MaxType : array[0..2] of string=('lower or equal  ','?-ERROR!        ',
  65.                                            'lower           ');
  66. var MinStr, MaxStr : String;
  67.     i : integer;
  68. begin
  69. if (Trunc(MinReal)<>MinReal) OR (Trunc(MaxReal)<>MaxReal) then i:=2
  70. else i:=0;
  71. Str(MinReal:10:i, MinStr);
  72. Str(MaxReal:10:i, MaxStr);
  73. while (MinStr[1]=' ') AND (1<=Length(MinStr))  do Delete(MinStr,1,1);
  74. while (MaxStr[1]=' ') AND (1<=Length(MaxStr))  do Delete(MaxStr,1,1);
  75. while Length(MinStr)<Length(MaxStr)  do Insert(' ',MinStr,1);
  76. while Length(MinStr)>Length(MaxStr)  do Insert(' ',MaxStr,1);
  77. if (MinReal=MaxReal)  then
  78.   MessageBox(#13+^C'Value must be '+ MinStr + '.',nil,mfError + mfOKButton)
  79. else
  80.   MessageBox('Value must be '+#13+
  81.             + RRV_MinType[MinType] + MinStr + ' and '+#13+
  82.             + RRV_MaxType[MaxType] + MaxStr + '.',nil,mfError + mfOKButton);
  83. end;
  84.  
  85.  
  86. function TRealRangeValidator.IsValid (const S: String): Boolean;
  87. var Value : real;
  88.     Code  : integer;
  89.     Data  : string;
  90. begin
  91. Data:=S; { do not modify displayed string !!! }
  92. { "," -> "."  for german notation...!!! }
  93. (*while Pos(',', Data) > 0  do Data[Pos(',', Data)] := '.';*)
  94. Val(Data, Value, Code);
  95. if Code<>0  then IsValid:=False
  96. else begin
  97.   if (MinReal=MaxReal) AND (Value<>MinReal)  then IsValid:=False
  98.   else begin
  99.     IsValid:=True;
  100.     case MinType of
  101.       RRV_equal  : if Value< MinReal  then IsValid:=False;
  102.       RRV_higher : if Value<=MinReal  then IsValid:=False;
  103.       RRV_lower  : IsValid:=False; { (debug only)  Spock:"Most illogical." }
  104.     end;
  105.     case MaxType of
  106.       RRV_equal  : if Value> MaxReal  then IsValid:=False;
  107.       RRV_lower  : if Value>=MaxReal  then IsValid:=False;
  108.       RRV_higher : IsValid:=False; { (debug only)  Spock:"Most illogical." }
  109.     end;
  110.   end;
  111. end
  112. end;
  113.  
  114. procedure TRealRangeValidator.Store (var S: TStream);
  115. begin
  116. inherited Store (S);
  117. S.Write (MinReal,SizeOf (MinReal));
  118. S.Write (MaxReal,SizeOf (MaxReal));
  119. S.Write (MinType,SizeOf (MinType));
  120. S.Write (MaxType,SizeOf (MaxType));
  121. end;
  122.  
  123. function TRealRangeValidator.Transfer (var S: String; Buffer: Pointer;
  124.                                        Flag: TVTransfer): Word;
  125. var
  126.    Value: Real;
  127.    Code: Integer;
  128. begin
  129. if Options and voTransfer <> 0 then
  130.   begin
  131.   Transfer := SizeOf (Value);
  132.   case Flag of
  133.     vtGetData: begin
  134.       Val (S,Value,Code);
  135.       Real (Buffer^) := Value;
  136.       end;
  137.     vtSetData: Str (Real (Buffer^),S);
  138.     end;
  139.   end
  140. else Transfer := 0;
  141. end;
  142.  
  143. END.  { of UNIT }
  144.  
  145. (* template taken from:
  146.  
  147. #: 199603 S1/Turbo Vision
  148.     13-Mar-93  03:44:06
  149. Sb: #199584-#TVal for real no.
  150. Fm: Steve Schafer (TeamB) 76711,522
  151.  
  152. Here's a unit which defines a validator for the single type. You can easily
  153. modify it to accomodate other floating-point types. You'll probably want to
  154. modify the Error method, too.
  155.